home *** CD-ROM | disk | FTP | other *** search
/ GFX Sensations 1 / Graphic Sensations - Volume 1.iso / tools / amiga / 3d_tools / 3dots.lha / 3Dots / Source / 3Dots.ASCII < prev   
Encoding:
Text File  |  1994-06-23  |  3.4 KB  |  171 lines
  1. ; *******************************************************
  2. ;                        3Dots
  3. ;                    by Don Finlay
  4. ; *******************************************************
  5. WBStartup
  6. ;
  7. Statement alert{text$}
  8.   TextGadget 4,203,46,0,1,"O.K."
  9.   Window 4,16,64,280,63,$1000,"We have a problem!",1,2,4
  10.   WLocate 11,10
  11.   Print text$
  12.     Repeat
  13.       ev4.l= WaitEvent
  14.     Until ev4=$40  ;gadget released
  15.   Free Window 4
  16. End Statement
  17. ;
  18. Screen 0,0,0,640,256,4,$8000,"Make 3D... Use menu to load picture",4,3
  19. LoadPalette 0,"title"
  20. Use Palette 0
  21. ;
  22. MenuTitle 0,0,"Project"           ;set menue for screen 0
  23. MenuItem 0,0,0,0,"Load     ","L"
  24. MenuItem 0,0,0,1,"Quit     ","Q"
  25. ;
  26. MaxLen path$=192  ;must have this info before we use requester
  27. MaxLen name$=192
  28. ;
  29. Window 0,0,10,640,246,$1800,"",1,2
  30. LoadScreen 0,"title"
  31. SetMenu 0
  32. ;
  33. loop1:
  34. Repeat
  35. ev1.l=WaitEvent
  36. Select ev1.l
  37.   Case 256    ;A menu event
  38.     Select ItemHit
  39.       Case 0  ;wants to load a pic
  40.         p$=FileRequest$("File to Load",path$,name$)
  41.           If p$=""   ;no file selected
  42.             Goto loop1
  43.           EndIf
  44.         Gosub loadpic  ;open screen backdrop and menus
  45.         Pop Select
  46.       Case 1  ;get out of here!
  47.       End
  48.     End Select
  49. End Select
  50. Forever
  51. ;
  52. .loadpic:
  53. ILBMInfo p$
  54. d= ILBMDepth
  55. wide.l = ILBMWidth
  56. h.l= ILBMHeight
  57. ;
  58. If wide>320
  59.   Then m=$8000   ;should this be m.l ?
  60.   Else m=0
  61. EndIf
  62. ;
  63. If d>3    ;pic has more than 8 colors
  64.   alert{"Picture has more than 8 colors"}
  65.   Goto loop1
  66. EndIf
  67. If h>256  ;Interlace
  68.   m=m+$4
  69. EndIf
  70. ;
  71. Screen 1,0,0,wide,h,d,m,"",0,1
  72. ;
  73. MenuTitle 1,0,"Project"
  74. MenuItem 1,0,0,0,"Make 3D"
  75. MenuItem 1,0,0,1,"Save Screen"
  76. MenuItem 1,0,0,2,"Print"
  77. MenuItem 1,0,0,3,"Quit"
  78. ;
  79. Window 1,0,0,wide,h,$1800,"",2,3 ;open backdrop to protect grafx
  80. SetMenu 1   ;attach menu to above window
  81. ;
  82. ScreensBitMap 1,1
  83. LoadPalette 1,p$       ;get pic palette
  84. Use Palette 1
  85. LoadScreen 1,p$            ;load pic
  86. Use Palette 1
  87. Free Window 0  ;Free up some memory
  88. Free Screen 0
  89. ;
  90. .main
  91. Repeat
  92. ev2.l=WaitEvent
  93. Select ev2.l
  94.   Case 256    ;A menu event
  95.     Select ItemHit
  96.       Case 0 ; Make it
  97.         Gosub Make3D
  98.       Case 1 ;save it
  99.         Gosub saveit
  100.       Case 2
  101.         Gosub printit
  102.       Case 3 ; Quit
  103.         Free Window 1
  104.         Free Screen 1
  105.         Pop Select
  106.         End
  107.     End Select
  108. End Select
  109. Forever
  110. ;
  111. .Make3D
  112. part = wide/8
  113. PalRGB 1,0,0,0,0    ;set color reg. 0 & 1 to black and white
  114. PalRGB 1,1,15,15,15 ;for re write of buffer to screen
  115. Use Palette 1
  116. ;
  117. Dim buff(wide+100)  ;set up work area. Larger than scan
  118.                     ;line so that there is room to match
  119.                     ;pixels with those on right edge of
  120.                     ;screen
  121. ;
  122. For down = 0 To h
  123.   For fill = 0 To wide  ;fill buff with rnd 0 or 1
  124.      buff(fill)= Rnd(Int(2))
  125.   Next
  126.   xpix = 0
  127.   While xpix < wide
  128.     col = Point(xpix,down)
  129.     Select col
  130.       Case 0
  131.         same = part+7
  132.       Case 1
  133.         same = part+6
  134.       Case 2
  135.         same = part+5
  136.       Case 3
  137.         same = part+4
  138.       Case 4
  139.         same = part+3
  140.       Case 5
  141.         same = part+2
  142.       Case 6
  143.         same = part+1
  144.       Case 7
  145.         same = part
  146.     End Select
  147.     buff(xpix+same) = buff(xpix)
  148.     xpix = xpix + 1
  149.   Wend
  150.   ;
  151.   For newpic = 0 To wide
  152.     Plot newpic,down,buff(newpic)
  153.   Next
  154. Next
  155. Return
  156. ;
  157. .saveit
  158. MaxLen spath$=192  ;must have this info before we use requester
  159. MaxLen sname$=192
  160. loop2:
  161. ps$=FileRequest$("File to Load",spath$,sname$)
  162. If ps$ = "" Then Goto loop2
  163. SaveScreen 1,ps$
  164. Return
  165. ;
  166. .printit
  167. Hardcopy 1,0,0,wide,h,wide,h*4,$440
  168. Return
  169. ;
  170. End
  171.